unit Funcoes;

interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls,Dialogs,
     ExtCtrls, IniFiles,  StdCtrls, Db, FileCtrl, IBDatabase, IBQuery, IBSQL;

procedure ExecSql(ValorSql :String;txn :TIBTransaction);
function RetornaValor(sSql: string;Trans: TIBTransaction=nil):Variant;
function  CGC_Valido(s: string): boolean;
function  CPF_Valido(s: string): boolean;
function  ExtraiDigitos( Texto: string ):string;
Function  Completa(s:String; P: String ;n:Integer):String;
Function  CompletaEsq(s:String; P: String ;n:Integer):String;


implementation

uses untPrincipal, untDmPrincipal;

function RetornaValor(sSql: string;Trans: TIBTransaction=nil):Variant;
var
  PTransaction : TIBTransaction;
begin
  if Trans = nil then
  begin
    PTransaction := dmPrincipal.TransactionAux;
    if not dmPrincipal.TransactionAux.active then
      dmPrincipal.TransactionAux.StartTransaction;
  end
  else
    PTransaction := Trans;

  with TIBQuery.create(nil) do
  begin
    try
      Database := dmPrincipal.Database;
      Transaction :=  PTransaction;
      sql.text := sSql;
      open;
      Result := Fields[0].Value;
      if Trans = nil then
        PTransaction.RollbackRetaining;
      Free;
    except
      if Trans = nil then
        PTransaction.RollbackRetaining;
      Free;
    end;
  end;
end;

procedure ExecSql(ValorSql :String;txn :TIBTransaction);
var
  txnActive :Boolean;
begin
  with TIBSQL.Create(nil) do
  begin
    try
      Database := dmPrincipal.Database;
      Transaction := txn;
      txnActive := txn.InTransaction;
      SQL.Text:= ValorSql;
      if not txnActive then
      begin
        txn.StartTransaction;
        ExecQuery;
        txn.CommitRetaining;
      end
      else
        ExecQuery;
      Free;
    except
      Free;
    end;
  end;
end;

Function Completa(s:String; P: String ;n:Integer):String;
(**************************************)
Var i:Integer;
Begin
     Result:=Copy(S,1,N);

     WHILE LENGTH(RESULT) < N DO
     BEGIN
          RESULT := RESULT + P ;
     END;
End;

Function CompletaEsq(s:String; P: String ;n:Integer):String;
(**************************************)
Var i:Integer;
Begin
     Result:=Copy(S,1,N);

     WHILE LENGTH(RESULT) < N DO
     BEGIN
          RESULT := P + RESULT ;
     END;
End;

function  ExtraiDigitos( Texto: string ):string;
var
  i : integer;
  sAux : string;
begin
  sAux := '';
  for i:=1 to length(Texto)do
  begin
    if Texto[i] in ['0'..'9'] then
      sAux := sAux + Texto[i];
  end;

  If trim(sAux) <> ''
  then
      result := sAux
  else
      result := '0';
end;

function Valch(ch: char): byte;
begin
  Valch:= ord(ch)-48;
end;

(***********************************************************)
function CGC_Valido(s: string): boolean;
(***********************************************************)
const
  peso1: array[1..12] of integer =
    (5,4,3,2,9,8,7,6,5,4,3,2);
  peso2: array[1..13] of integer =
    (6,5,4,3,2,9,8,7,6,5,4,3,2);
var
  //s: string[14];
  d1,d2: byte;
  i,soma: integer;
  doc : string;
begin
  //str(cgc:0:0,s);
  doc := StringReplace(s,'.','',[rfReplaceAll]);
  doc := StringReplace(doc,'-','',[rfReplaceAll]);
  doc := StringReplace(doc,'/','',[rfReplaceAll]);
  s := doc;
  insert(copy('00000000000000',1,14-length(s)),s,1);
  soma:= 0;

  for i:= 1 to 12 do
    soma:= soma + peso1[i]*Valch(s[i]);

  d1:= soma mod 11;

  if (d1 = 0) or (d1 = 1)
  then
      d1:= 0
  else
      d1:= 11 - d1;

  if d1 <> Valch(s[13])
  then begin
       CGC_Valido:= false;
       exit;
  end;

  soma:= 0;

  for i:= 1 to 13 do
    soma:= soma + peso2[i]*Valch(s[i]);

  d2:= soma mod 11;

  if (d2 = 0) or (d2 = 1)
  then
      d2:= 0
  else
      d2:= 11 - d2;

  if d2 = Valch(s[14])
  then
      CGC_Valido:= true
  else
      CGC_Valido:= false;
end;

(***********************************************************)
function CPF_Valido(s: string): boolean;
(***********************************************************)
const
  peso1: array[1..9] of integer =
    (0,9,8,7,6,5,4,3,2);
  peso2: array[1..10] of integer =
    (1,0,9,8,7,6,5,4,3,2);
var
  //s: string[11];
  d1,d2: byte;
  i,soma: integer;

  function vpeso1: integer;
  begin
    if (i=1) and (peso1[i]=0) then
      vpeso1:= 10
    else
      vpeso1:= peso1[i];
  end;

  function vpeso2: integer;
  begin
    if (i=1) and (peso2[i]=1) then
      vpeso2:= 11
    else if (i=2) and (peso2[i]=0) then
      vpeso2:= 10
    else
      vpeso2:= peso2[i];
  end;

begin
  //str(cpf:0:0,s);
  insert(copy('00000000000',1,11-length(s)),s,1);
  soma:= 0;
  for i:= 1 to 9 do
    soma:= soma + vpeso1*Valch(s[i]);
  d1:= soma mod 11;
  if (d1 = 0) or (d1 = 1) then
    d1:= 0
  else
    d1:= 11 - d1;
  if d1 <> Valch(s[10]) then
  begin
    CPF_Valido:= false;
    exit;
  end;
  soma:= 0;
  for i:= 1 to 10 do
    soma:= soma + vpeso2*Valch(s[i]);
  d2:= soma mod 11;
  if (d2 = 0) or (d2 = 1) then
    d2:= 0
  else
    d2:= 11 - d2;
  if d2 = Valch(s[11]) then
    CPF_Valido:= true
  else
    CPF_Valido:= false;
end;

end.
